OHIBC: Calculate All Scores

knitr::opts_chunk$set(fig.width = 6, fig.height = 4, fig.path = 'Figs/',
                      echo = TRUE, message = FALSE, warning = FALSE)

library(ohicore) ### devtools::install_github('ohi-science/ohicore')

source('~/github/ohibc/src/R/common.R')

dir_ohibc  <- '~/github/ohibc'
dir_calc   <- file.path(dir_ohibc, 'calc_ohibc')
dir_master <- file.path(dir_calc, 'master')

source(file.path(dir_calc, 'calc_scores_fxns.R'))

### provenance tracking
# library(provRmd); prov_setup()

1 Set up scenarios

Set up scenarios by assigning years. Each scenario (eg. ‘region2015’) will be tied to a specific data year, not floating as in global OHI.

• Prepare scenario folders
• create scenario dirs and subdirs
• copy config files from master to scenarios
• Copy layers from prep to layers folder #####
• Read in the layers.csv file with paths to the data files
• Register layers based on include == TRUE and identify file locations
• check that all data layers are available based on file paths
• copy layers into current layers folder
• Check that all layers conform with details in config (layers.csv)

prep_scenario_dirs(dir_calc, dir_master, master_flag = '_master', purge = TRUE)
# prep_scenario_dirs(dir_calc2, dir_master, master_flag = '_master_scenario2', purge = TRUE)

### copy layers from data sources to layers folder
message('Copying all layers to ', file.path(dir_calc, 'layers'))

layers_log <- read_csv(file.path(dir_master, 'layers_ohibc.csv')) %>%
  mutate(dir_prep = file.path(dir_ohibc, str_replace(dir_prep, 'ohibc:', '')))

lyrs <- register_layers(layers_log, dir_calc)

verify_layers(lyrs)

copy_layers_to_scenario(lyrs)

write_csv(lyrs %>% 
            select(-path_in, -path_in_exists, -path_out),
          file.path(dir_calc, 'layers.csv'))

### confirm all layers conform to details of layers.csv
conf   <- Conf(file.path(dir_calc, 'conf'))

capture.output( ### the function prints a lot crap to screen - let's change those to messages please!
  {
    CheckLayers(layers.csv = file.path(dir_calc, 'layers.csv'),
              layers.dir = file.path(dir_calc, 'layers'),
              flds_id    = conf$config$layers_id_fields)
  },
  file = 'delete_this.txt')
unlink('delete_this.txt')

2 Iterate across scenario years

• Initialize conf, layers; store working directory in layers$data$dir_calc so it can be accessed by functions.R
• Initialize scores_all dataframe to hold scores for all years
• Calculate scores for each scenario and append to scores_all

status_years <- read_csv(file.path(dir_calc, 'master/status_year_matrix_master.csv')) %>%
  .$status_year %>%
  unique()

conf   <- Conf(file.path(dir_calc, 'conf'))
layers <- Layers(layers.csv = file.path(dir_calc, 'layers.csv'),
                 layers.dir = file.path(dir_calc, 'layers'))

layers$data$dir_calc   <- dir_calc
layers$data$stat_yr_matrix <- read_csv(file.path(dir_calc, 'conf/status_year_matrix.csv'))
layers$data$year_span <- 1990:2016

scores_all <- data.frame() ### initialize scores

for (status_year in status_years) {
  
  # if(!exists('status_year')) status_year <- status_years[1]

  message('Calculating scores for ', status_year)

  ### For each run through loop, assign status_year inside
  ###   the layers object/env't so it is accessible to functions.R
  layers$data$status_year <- status_year

  capture.output( ### the function prints crap to screen
    {
      scores <- CalculateAll(conf, layers) %>%
        mutate(yr_text = status_year,
               year    = as.integer(str_replace_all(status_year, '[^0-9]', '')))
    },
    file = 'delete_this.txt')
  unlink('delete_this.txt')

  scores_all <- scores_all %>%
    bind_rows(scores)

}

write_csv(scores_all, file.path(dir_calc, 'scores_all.csv'))

x <- scores_all %>%
  filter(dimension %in% c('status', 'trend')) %>%
  filter(!(score == 0 & dimension == 'status'))

2.1 Status plots

scores <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
  filter(dimension %in% c('status', 'trend')) %>%
  spread(dimension, score) %>%
  filter(!is.na(status)) %>%
  left_join(get_rgn_names(), by = c('region_id' = 'rgn_id'))

for(goalname in scores$goal %>% unique() %>% sort) {
  # goalname <- scores$goal[1]
  scores_tmp <- scores %>%
    filter(goal == goalname)
  status_plot <- ggplot(scores_tmp %>% 
                          filter(region_id != 0), 
                      aes(x = year, y = status, color = rgn_name)) +
    ggtheme_plot() +
    geom_line(data = scores_tmp %>% 
                filter(region_id == 0), 
              aes(x = year, y = status), size = 1.5, color = 'grey20', alpha = .8) +
    geom_line(aes(group = region_id)) +
    scale_x_continuous(breaks = scores_tmp$year %>% unique() %>% sort) +
    scale_y_continuous(limits = c(0, 100)) +
    theme(axis.text.x = element_text(angle = 30)) +
    labs(color = goalname)

  print(status_plot)
}

2.2 Fisheries breakdown

  ## plotting fishery catch weighting by region
  stock_plot_df <- read_csv(file.path(dir_ohibc, 'prep/fis/v2017/summary/fis_from_functions.csv')) %>%
    group_by(region_id, year) %>%
    mutate(total_catch = sum(rgn_catch),
           rgn_catch_pct = rgn_catch / total_catch,
           total_score = sum(score * rgn_catch) / total_catch) %>%
    ungroup() %>%
    left_join(get_rgn_names(), by = c('region_id' = 'rgn_id'))

  for(rgn in 1:8) {
    rgn_plot_df <- stock_plot_df %>%
      filter(region_id == rgn)
    status_plot <- ggplot(rgn_plot_df, aes(x = year, y = score)) +
      geom_line(aes(group = stock_id, color = stock_id,
                    size = rgn_catch_pct),
                lineend = 'round', alpha = .5) +
      scale_size_continuous(guide = FALSE) +
      geom_line(data = rgn_plot_df %>%
                  select(year, total_score) %>%
                  distinct(),
                aes(x = year, y = total_score),
                size = 1.5, color = 'grey30')  +
      labs(title = first(rgn_plot_df$rgn_name),
           color = 'Stock ID',
           y     = 'Proportion of catch')
    print(status_plot)
  }

# prov_wrapup(commit_outputs = FALSE)